(defpackage :history
  (:use :cl)
  (:nicknames :h)
  (:shadow :push :last)
  (:export :history
           :before
           :after
           :current
           :item
           :item-data
           :item-correctp
           :item-extra
           :forward
           :back
           :push
           :push-item
           :jump
           :rewind
           :last-correct-state-item
           :last
           :last-if
           :next
           :next-if
           :item-before))

(in-package :history)

(defclass history ()
  ((before :initform nil :accessor before)
   (current :initform nil :accessor current)
   (after :initform nil :accessor after)))

(defmethod print-object ((obj history) stream)
  (print-unreadable-object (obj stream)
    (format stream "~a :before ~s :current ~s :after ~s" (type-of obj) (before obj) (current obj) (after obj))))

(defclass item ()
  ((data :initarg :data :accessor item-data)
   (correctp :initarg :correctp :accessor item-correctp)
   (extra :initform nil :initarg :extra :accessor item-extra
                   :documentation "any extra data, if any, that should be stored with the data slot.")))

(defmethod print-object ((obj item) stream)
  (print-unreadable-object (obj stream)
    (format stream "item :data ~s :correct ~s" (item-data obj) (item-correctp obj))))

(defgeneric forward (history)
  (:documentation "return the next item and store current."))
(defgeneric back (history)
  (:documentation "return the previous item and store current."))
(defgeneric push (history item correctp &optional extra)
  (:documentation "store item in the before list."))
(defgeneric push-item (history item))
(defgeneric dir-until (history function slot1 slot2))
  
(defmethod forward ((history history))
  (when (after history)
    (cl:push (current history) (before history))
    (setf (current history) (pop (after history)))))

(defmethod back ((history history))
  (when (before history)
    (cl:push (current history) (after history))
    (setf (current history) (pop (before history)))))

(defmethod push-item ((history history) (item item))
  (setf (after history) nil)
  (cl:push item (before history)))

(defmethod push ((history history) item correctp &optional extra)
  (push-item history (make-instance 'item
                                    :data item
                                    :extra extra
                                    :correctp correctp)))

(defun jump (history item)
  "Find item in history and jump to it. Returns T when successful. NIL
if item doesn't exist in history."
  (cond
    ((eq (current history) item)
     t)
    ((find item (before history))
     (setf (after history)
           (append (cdr (member item (reverse (before history))))
                   (list (current history))
                   (after history))
           (before history) (cdr (member item (before history)))
           (current history) item)
     t)
    ((find item (after history))
     (setf (before history)
           (append (cdr (member item (reverse (after history))))
                   (list (current history))
                   (before history))
           (after history) (cdr (member item (after history)))
           (current history) item)
     t)
    (t
     (print `(bing ,item))
     nil)))

(defun rewind (history)
  (jump history (u:last1 (before history))))

(defun last-correct-state-item (history)
  (loop for last = nil then i
     for i in (reverse (cons (current history) (before history)))
     when (not (item-correctp i))
     return last))

(defun last (history)
  (car (before history)))

(defun last-if (history function)
  "Return the last state that satisfies function"
  (find-if function (before history)))

(defun next (history)
  (car (after history)))

(defun next-if (history function)
  (find-if function (after history)))

(defun item-before (history item)
  "Return the item in HISTORY that is before ITEM."
  (cond
    ((eq item (current history))
     (car (before history)))
    ((find item (before history))
     (second (member item (before history))))
    ((find item (after history))
     (second (member item (reverse (after history)))))
    (t nil)))
